home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / usenet / st80_pre4 / pretty-print / exampleChange.st < prev    next >
Text File  |  1993-07-24  |  8KB  |  305 lines
  1. "======================================================================
  2. |
  3. |         exampleChange.st
  4. |
  5. | This is part of a Smalltalk change log file (from V/Mac).
  6. |
  7. | Copyright (C) 1991 Mark L. Fussell.
  8.  ======================================================================"!
  9.  
  10.  
  11. !Stream methods !
  12. startChunk
  13.     "For outputting chunks as seperate operations"
  14.  
  15.     "Don't need to do anything... the end of the chunk is all
  16.      important".! !
  17.  
  18. !Stream methods !
  19. middleChunkPut: aString
  20.     "Used with start/end-Chunk. Output aString doubling
  21.      embedded !!'s. Destination is receiver stream."
  22.  
  23.     aString do: [ :character |
  24.         self nextPut: character.
  25.         character == $!!
  26.             ifTrue: [self nextPut: $!!]].
  27.     ^ aString! !
  28.  
  29. "evaluate"
  30. Stream removeSelector: #middleChunk:!
  31.  
  32. "evaluate"
  33. LibFiling fileOut: ClassReaderTest
  34.            onFile: 't'
  35.       withSources: true
  36.       withSummary: true
  37.            forTex: true
  38.        texMethods: true.!
  39.  
  40.  
  41. !LibGeneral1 class methods !
  42. getMethodsCommentsOnClass: class selectors: s on: outStream texMethods:  
  43. texMethods
  44.     | inStream
  45.       code selectorWords
  46.       endSelector startComment endComment
  47.       line occur attributes b
  48.     |
  49.  
  50.     s do: [:selector |
  51. "        selectorParts := ATest splitSelectors: selector.
  52.         lastSelector := selectorParts at: selectorParts size.       "
  53.         code := class sourceCodeAt: selector.
  54.         code := (MethodAttributes stripAttributes: code) at: 1.
  55.  
  56.  
  57.  
  58.  
  59.             "The next string 'No source...' is broken so that this
  60.              routine won't cause a match"
  61.         ((Pattern new: 'No source ','is available')
  62.                 match: code index: 1) isNil ifFalse: [
  63.             b isNil ifTrue: [b := ByteDecoder standardDecoder].
  64.             b decodeCompiledMethod: (class compiledMethodAt: selector)
  65.                                 on: (code := WriteStream on: code).
  66.             b printPrettyOn: code.
  67.  
  68.             code := code contents.
  69.  
  70. "
  71.             outStream nextPutAll: selector.
  72.             selector size < 20 ifFalse: [
  73.                    outStream cr; next: 20 put: $ ;
  74.                     nextPutAll: '     *** No source ','is available';cr;cr.
  75.             ] ifTrue: [
  76.                 outStream next: (20 - selector size) put: $ .
  77.                 outStream nextPutAll: '     *** No source ','is available';cr.
  78.             ].
  79.             code := nil.
  80. "
  81.  
  82.         ].
  83.  
  84.         (code notNil) ifTrue: [
  85.                 "This next part creates a pattern to grab the
  86.                  whole method declaration"
  87.  
  88.             inStream := ReadStream on: code.
  89.  
  90.             selectorWords := selector occurrencesOf: $:.
  91.             selectorWords > 0 ifTrue: [
  92.                 1 to: selectorWords  do: [:i |
  93.                     inStream nextWord.      "Get Selector"
  94.                     inStream nextWord.      "and parameter"
  95.                 ].
  96.             ] ifFalse: [
  97.                 (selector at: 1) isAlphaNumeric ifTrue: [
  98.                     inStream nextWord.      "only have selector"
  99.                 ] ifFalse: [
  100.                     inStream nextWord.      "Get Selector and parameter"
  101.                 ].
  102.             ].
  103.  
  104.  
  105.             inStream skip: -1.  "back up onto the last character
  106.                                  of the word (instead of LF)"
  107.  
  108.             endSelector := inStream position.   "Now have the end of the  
  109. message selector"
  110.             startComment := endSelector + 1.
  111.             endComment := endSelector.
  112.  
  113.             "inStream countBlanks.      ?? skip blanks"
  114.             line := (inStream nextLine) trimBlanks.
  115.  
  116.  
  117.  
  118.             [(inStream atEnd not) and: [line size < 1]]
  119.                     whileTrue: [           "skip over blank lines"
  120.                 startComment := inStream position + 1.
  121.                 line := (inStream nextLine) trimBlanks.
  122.             ].
  123.  
  124.             occur := (line occurrencesOf: $").
  125.             occur > 0 ifTrue: [
  126.                 occur > 1 ifTrue: [
  127.                     endComment := inStream position - 1.  "back up from the  
  128. LF"
  129.                 ] ifFalse: [
  130.                     inStream skipTo: $".
  131.                     endComment := inStream position.
  132.                 ].
  133.             ].
  134.  
  135.  
  136.             "texMethods ifTrue: [outStream nextPut: Tab].   "
  137.             outStream nextPutAll: (code copyFrom: 1 to: endSelector).
  138.             "texMethods ifTrue: [outStream nextPut: $ ;nextPut: Tab].  "
  139.  
  140.  
  141.             endComment > startComment ifTrue: [
  142.                 (endSelector < 20 and: [endComment - startComment < 60])  
  143. ifTrue: [
  144.                     outStream next: (20 - endSelector) put: $ . "pad to the  
  145. tab"
  146.                     outStream nextPutAll: (code copyFrom: startComment to:  
  147. endComment) stripComments;cr.
  148.                 ] ifFalse: [
  149.                     outStream cr.
  150.                     outStream nextPutAll: (code copyFrom: startComment to:  
  151. endComment) stripComments;cr.
  152.                     outStream cr.
  153.                 ].
  154.             ] ifFalse: [
  155.                 outStream cr.       "add the last lines cr"
  156.             ].
  157.         ]. "End ifTrue"
  158.     ].
  159.     ^outStream
  160.  
  161.  
  162. "
  163.             attributes notNil ifTrue: [
  164.                 attributes printAttributesStringOn: outStream.
  165.                 outStream cr.
  166.             ].
  167. "! !
  168.  
  169.  
  170. !Blower methods !
  171. atSpeedValue
  172.         <<Private>>
  173.     ^120! !
  174.  
  175. !Blower methods !
  176. initialize
  177.         <<Private>>
  178.     | sim  |
  179.  
  180.     on := MBoolean new.
  181.     on toFalse.
  182.  
  183.     speed := MInterval new.
  184.     speed min: 0 max: 300 precision: 1.
  185.     speed addDependent: self.
  186.  
  187.  
  188.     sim := BlowerSim new.
  189.  
  190.     internalModels := OrderedCollection with: sim.
  191.  
  192.     sim initChange: speed on: on
  193.            plus: 10 minus: 20 per: #fiveSecondEvent
  194.            atSpeed: (self atSpeedValue).! !
  195.  
  196. !Blower methods !
  197. initWindowSize
  198.         <<Public>><<Widget>>
  199.     "Tell the topWidget what size to open to"
  200.  
  201.     | listLineHeight halfLineHeight |
  202.     listLineHeight := Font menuFont height + 12.
  203.     halfLineHeight := Font menuFont height + 6.
  204.  
  205.     ^200@((3*listLineHeight) + (halfLineHeight*1))! !
  206.  
  207. !Boiler methods !
  208. initialize
  209.         <<Public>>
  210.     | sim  |
  211.  
  212.     oilValve := Valve new.
  213.     oilValve addDependent: self.
  214.  
  215.     ignitor := Ignitor new.
  216.  
  217.     oilFlowSensor := MBoolean new.
  218.     oilFlowSensor addDependent: self.
  219.  
  220.     combustionSensor := MBoolean new.
  221.     combustionSensor addDependent: self.
  222.  
  223.     tempSensor := MInterval new.
  224.     tempSensor
  225.         min: 60 max: 300 precision: 2.
  226.     tempSensor addDependent: self.
  227.  
  228.  
  229.     sim := BoilerSim new.
  230.     sim initChange: tempSensor on: oilValve
  231.         plus: 15 minus: 10 per: #fiveSecondEvent
  232.         atTemp: 220.
  233.  
  234.     internalModels := OrderedCollection with: sim.! !
  235.  
  236. !Boiler methods !
  237. initWindowSize
  238.         <<Public>><<Widget>>
  239.     "Tell the topWidget what size to open to"
  240.     | listLineHeight halfLineHeight |
  241.     listLineHeight := Font menuFont height + 12.
  242.     halfLineHeight := Font menuFont height + 6.
  243.  
  244.     ^200@((6*listLineHeight) + (halfLineHeight*0) - 2)! !
  245.  
  246. !Boiler methods !
  247. initWindowSize
  248.         <<Public>><<Widget>>
  249.     "Tell the topWidget what size to open to"
  250.     | listLineHeight halfLineHeight |
  251.  
  252.     listLineHeight := Font menuFont height + 12.
  253.     halfLineHeight := Font menuFont height + 6.
  254.  
  255.     ^200@((6*listLineHeight) + (halfLineHeight*0) - 2)! !
  256.  
  257. !Boiler methods !
  258. modelReleased: who
  259.         <<Public>><<Widget>>
  260.     "The top Pane lost a model for one of its subPanes.
  261.      The whole window should close."
  262.  
  263.     ^true! !
  264.  
  265. !Boiler methods !
  266. oilFlowSensor
  267.         <<Limited>>
  268.     ^oilFlowSensor! !
  269.  
  270. !Boiler methods !
  271. oilValve
  272.         <<Limited>>
  273.     ^oilValve! !
  274.  
  275. TestHeating subclass: #Furnace
  276.   instanceVariableNames: 
  277.     'heatingSystem  state  boiler  blower  startCoolingTime  
  278.      activateDesired  internalModels  '
  279.   classVariableNames: ''
  280.   poolDictionaries: ''.
  281.  
  282. Furnace
  283.   comment:
  284. '
  285.  
  286. A furnace is composed of:
  287.     Boiler
  288.     Blower
  289.  
  290. Internal values:
  291.     startCoolingTime
  292.     activateDesired
  293.  
  294. The object <state> is a Furnace state and
  295. handles validating state moves (basically
  296. it just prevents missspellings.)
  297. '
  298. .
  299. !
  300. !Furnace class methods !
  301. newForSystem: aSystem
  302.         <<Public>>
  303.  
  304.     ^super new initForSystem: aSystem.! !
  305.